home *** CD-ROM | disk | FTP | other *** search
/ Business Shareware / Business Shareware.iso / start / wordproc / me_cd25 / compile.mut < prev    next >
Encoding:
Text File  |  1992-11-09  |  13.3 KB  |  480 lines
  1. ;; compile.mut 
  2. ;; 
  3. ;; Remote, multi-process compiles or greps.
  4. ;; Modeled after compile and grep in GNU Emacs.
  5. ;; See documentation in package.doc
  6. ;; Functions:
  7. ;;   compile
  8. ;;   grep
  9. ;;   compile-next-error        C-x`
  10.  
  11. ;; C Durland 10/91, 1/92    Public Domain
  12.  
  13.  
  14. (include me2.h)
  15.  
  16. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  17. ;;;;;;;;;;;;;; Run the Compile Process ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  18. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  19.  
  20. (const
  21.   COMPILE-BUFFER-NAME    "*Compile*"
  22. )
  23.  
  24. (int compilation-buffer compile-process-id)
  25. (bool compile-in-progress scroll-compile)
  26. (string last-compile-command)
  27.  
  28. (defun
  29.   MAIN
  30.   {
  31.     (register-hook PROCESS-HOOK "process-compile-hook")
  32.     (last-compile-command "make")
  33.   }
  34.   compile
  35.   {
  36.     (string command)
  37.  
  38.     (do-the-compile-thing 
  39.       (if (== ""
  40.         (command (ask "Compile command [" last-compile-command "]: ")))
  41.     last-compile-command
  42.         (last-compile-command command))
  43.       "No more errors")
  44.   }
  45.   stop-compile
  46.   {
  47.     (if (not compile-in-progress) { (msg "No compile to stop!") (done) })
  48.     (msg "Sorry, haven't got that implemented yet.")
  49.   }
  50.   grep
  51.   {
  52.     (string command)
  53.  
  54.     (command (ask "Run grep (with args): "))
  55.     (do-the-compile-thing (concat "grep -n " command " /dev/null")
  56.     "No more grep matches")
  57.   }
  58. )
  59.  
  60.  
  61. (string compile-done-message)    ;; used by the error parser
  62.  
  63. (defun
  64.   do-the-compile-thing (string compile-command done-message) HIDDEN
  65.   {
  66.     (int wid)
  67.  
  68.     (if compile-in-progress
  69.       {
  70.     (ask-user)        ;; !!!??? hmmmm
  71.     (if (yesno "Got a compilation process going!  Stop it")
  72.       {
  73.         (msg "Sorry, haven't got that implemented yet.")
  74.         (done)
  75.       }
  76.       (done))
  77.       })
  78.  
  79. ;    (compile-process-id (create-process compile-command))
  80.     (compile-process-id
  81.     (create-process (concat "/bin/sh -c <*> exec " compile-command)))
  82.  
  83.     (if (== -1 compile-process-id) (done))        ;; some kind of error
  84.  
  85.     (if (== -2 (compilation-buffer (attached-buffer COMPILE-BUFFER-NAME)))
  86.        (compilation-buffer
  87.      (create-buffer COMPILE-BUFFER-NAME (bit-or BFFoo BFHidden2))))
  88.  
  89. ;!!!??? why not use popup-buffer?
  90. ;    (if (!= compilation-buffer (current-buffer))
  91.     (if (!= -2 (wid (buffer-displayed compilation-buffer)))
  92.       {
  93.           (current-window wid)
  94.         (if (< (window-height -1) 5) (window-height -1 8))
  95.       }
  96.       {
  97.         (delete-other-windows)(split-window)
  98.     (current-window 0)        ;; move to top window
  99.     (window-height -1 8)
  100.       })
  101.  
  102.     (current-buffer compilation-buffer TRUE) (clear-buffer)
  103.  
  104.     (insert-text "Directory: " (current-directory) "^J")
  105.     (insert-text "Now computing: " '"' compile-command '"' "^J")
  106.  
  107.     (set-mark THE-MARK)            ;; used by (compile-next-error)
  108.  
  109.     (compile-in-progress TRUE)(scroll-compile TRUE)
  110.     (major-mode "Running")
  111.     (next-window)        ;; leave cursor in original buffer
  112.  
  113.     (compile-done-message done-message)
  114.  
  115.     (init-error-parser)
  116.   }
  117.   process-compile-hook (int pid event-type)(message)
  118.   {
  119.     (int wid1 wid2)
  120.  
  121.     (if (== PERROR event-type)
  122.     {
  123.       (if compile-in-progress
  124.         { (current-buffer compilation-buffer) (major-mode "Error") (update) })
  125.       (compile-in-progress FALSE)
  126.       (done)
  127.     })
  128.     (if (not compile-in-progress) (done))
  129.     (if (!= compile-process-id pid) (done))
  130.  
  131.     (current-buffer compilation-buffer)(end-of-buffer)
  132.     (previous-character)    ;; ???something fishy about this
  133.     (switch event-type
  134.       PROCESS-DONE
  135.       {
  136.     (compile-in-progress FALSE)
  137.     (newline)
  138.     (insert-text "Process done.  Exit status:  " message)
  139.     (major-mode (concat "Done: " message))
  140.       }
  141.       OUTPUT-STDOUT { (insert-text message)(beginning-of-line) }
  142.       OUTPUT-STDERR { (insert-text message)(beginning-of-line) }
  143.     )
  144.  
  145.     
  146.         ;; if displayed, update
  147.     (if (and scroll-compile
  148.          (!= -2 (wid2 (buffer-displayed compilation-buffer))))
  149.       {
  150.     (wid1 (current-window))
  151.     (current-window wid2)
  152.     (end-of-buffer)
  153.     (update FALSE)        ;; sync buffer and window dots
  154.     (arg-prefix -1)(reposition-window)
  155.     (current-window wid1)
  156.     (update)        ;; get it onto the screen
  157.       })
  158.   }
  159. )
  160.  
  161. (defun
  162.   buffer-displayed (int buffer-id) HIDDEN
  163.   {
  164.     (int n)
  165.     (for (n 0) (< n (windows)) (+= n 1)
  166.     (if (== buffer-id (attached-buffer n)) { n (done) }))
  167.     -2            ;; buffer not displayed
  168.   }
  169. )
  170.  
  171.  
  172.  
  173.  
  174.  
  175.  
  176.  
  177.  
  178. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  179. ;;;;;;;;;;;;;; Process the Compile Errors ;;;;;;;;;;;;;;;;;;;;;;;;;;
  180. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  181.  
  182.  
  183. ;; Error list:  the stuff needed to find/mark errors in a file that has
  184. ;; been compiled and has errors/warnings.  These are:
  185. ;;   Name of the file with errors
  186. ;;   ?buffer id of the buffer holding the file
  187. ;;   List of tuples that mark each error.  These tuples are:  mark-id of
  188. ;;     the mark pointing to the error line, line number in the error list,
  189. ;;     number of lines of error message.
  190.  
  191. (list error-list)
  192.  
  193. (defun compile-next-error    ; display the next error or warning
  194. {
  195.   (int error-line-mark-id len-of-error-msg error-msg-line wid)
  196.   (string file-name)
  197.  
  198. ;  (if (arg-flag)
  199. ;    (init-error-parser) set-mark to top of compile buffer
  200.  
  201.  
  202.   (if (== 0 (length-of error-list))
  203.     (switch (parse-errors)
  204.       1 
  205.         {
  206.       (if (!= -2 (wid (buffer-displayed compilation-buffer)))
  207.         (free-window wid))
  208.       (msg compile-done-message)
  209.       (done)
  210.     }
  211.       2
  212.         {
  213.       (msg "Wait a sec while the process churns out some stuff.")
  214.       (scroll-compile TRUE)
  215.       (done)
  216.     }
  217.     ))
  218.  
  219.     ;; get info out of error-list
  220.   (file-name        (extract-element error-list 0))
  221.   (error-line-mark-id    (extract-element error-list 1))
  222.   (len-of-error-msg    (extract-element error-list 2))
  223.   (error-msg-line    (extract-element error-list 3))
  224.  
  225.   (remove-elements error-list 0 4)    ;; remove that tuple from the list
  226. ;(msg "ack: >" file-name "< " error-line-mark-id " " len-of-error-msg "  " error-msg-line)(get-key)
  227.  
  228.     ;; get the file and put the dot at the error line
  229.   (visit-file file-name)        ;; visit file with the error
  230. (msg "")
  231.   (goto-mark error-line-mark-id)    ;; put dot at error
  232. (update FALSE)
  233.  
  234.   (free-mark error-line-mark-id)    ;; do some cleanup
  235.  
  236.   (scroll-compile FALSE)
  237.  
  238.     ;; make a window to show error messages in
  239.   (delete-other-windows)(split-window)
  240.   (current-window 0)        ;; move to top window
  241.   (if (> len-of-error-msg 10)
  242.     {
  243.       (len-of-error-msg 10)
  244.       (msg "This line generated lots of errors!")
  245.     })
  246. ;(if (< len-of-error-msg 3) (len-of-error-msg 3))
  247.   (window-height -1 len-of-error-msg)
  248.     ;; display error message(s)
  249.   (current-buffer compilation-buffer TRUE)
  250.   (goto-line error-msg-line)(reposition-window)
  251.   (update FALSE)
  252.  
  253.   (current-window 1)
  254. })
  255.  
  256. (int bb-line)
  257. (string bb-fname)
  258.  
  259. (defun
  260.   init-error-parser HIDDEN    MAIN    ;; main so I can debug
  261.   {
  262.     (bind-to-key "compile-next-error"    "C-x`")
  263.  
  264.     (bb-fname "")
  265.  
  266.     (if (!= 0 (length-of error-list)) (msg "Got garbage to clean up"))
  267.  
  268.     (remove-elements error-list 0 100000)
  269. ;;!!!??? free marks in error-list?
  270.   }
  271. )
  272.  
  273.     ;; Parse the compilation buffer
  274.     ;; Output:
  275.     ;;   Stuff added to error-list
  276.     ;; Returns:
  277.     ;;   0 :  parsed some errors or error in error-list
  278.     ;;   1 :  no errors left to parse and compile is done
  279.     ;;   2 :  no errors left to parse but compile not done
  280. (defun parse-errors HIDDEN
  281. {
  282.   (int buffer-size dot lines buffer-row wasted char-at-dot)    ;; BufferInfo
  283.  
  284.   (int error-line len-of-error-msg mark-id n)
  285.   (string current-file-name file-name)
  286.  
  287.   (current-file-name bb-fname)    ;; init file change checker
  288.  
  289.     ;; make sure compile buffer didn't get deleted
  290.   (if  (== -2 (n (attached-buffer COMPILE-BUFFER-NAME)))
  291.     { (msg "Somebody deleted the " COMPILE-BUFFER-NAME " buffer!") (halt) })
  292.  
  293.   (current-buffer n)
  294.   (compilation-buffer n)
  295.  
  296.   (goto-mark THE-MARK)        ;; pick up where we last left off
  297.  
  298. ;(int foo)
  299. (msg "parse-errors: " (buffer-name -1))
  300.  
  301.   (while TRUE        ;; parse lots of errors
  302.   {
  303.     (msg "Parsing error messages ...")
  304.  
  305.     (while (and             ;; skip over garbage
  306.         (not (booboo-line))
  307.         (forward-line 1))
  308.     ())
  309.  
  310.     (if (EoB)        ;; nothing left to parse
  311.       {
  312.     (previous-character)    ;; ???something fishy about this
  313.     (set-mark THE-MARK)
  314.  
  315.     (if (!= 0 (length-of error-list)) { 0 (done) })
  316.     (if compile-in-progress          { 2 (done) })
  317.                         1 (done)
  318.       })
  319.  
  320.     ;; dot at the start of an error line
  321.     (snarf-error-info)
  322.     (error-line bb-line)
  323.     (file-name  bb-fname)
  324. ;(msg "hoho1 >" bb-fname "< " bb-line "    (" current-file-name ")")(get-key)
  325.  
  326.     ;; check for change of file
  327.     (if (!= current-file-name file-name)
  328.       (if (!= 0 (length-of error-list))    ;; already got some errors parsed
  329.     { 0 (done) }
  330.     {
  331.       (current-file-name file-name)
  332. ;(msg "new file: " file-name )(get-key)
  333.     }))
  334.  
  335.     ;; figure out where in the error buffer this message is
  336.     (buffer-stats -1 (loc buffer-size))
  337.  
  338.     (len-of-error-msg 1)
  339.     (while TRUE        ;; see if this is a long message
  340.       {
  341.     (if (not (forward-line 1)) (break))    ;; EoF
  342.     (if (booboo-line)
  343.       {
  344.         (snarf-error-info)
  345.         (if (or (!= current-file-name bb-fname)
  346.             (!= error-line bb-line))
  347.            (break))
  348.        }
  349.        (if (not (looking-at '\ +.')) (break)))
  350.  
  351.     (+= len-of-error-msg 1)
  352.       })
  353.  
  354. ;;;!!!??? limit the number of errors per line
  355.  
  356.     (set-mark THE-MARK)        ;; start of next error message
  357.  
  358. ;turds
  359. ;(msg "hoho3 >" current-file-name "<  >" file-name "<  " bb-fname)(get-key)
  360.  
  361.  
  362.     (visit-file file-name)        ;; visit file with the error
  363.     (mark-id (create-mark TRUE))
  364.     (goto-line error-line)(set-mark mark-id)
  365.  
  366.     (current-buffer compilation-buffer)
  367.  
  368. ;(msg "parsed: >"file-name "< " mark-id "  " len-of-error-msg "  " buffer-row " " error-line)(get-key)
  369.  
  370.     (insert-object error-list 10000
  371.     file-name mark-id len-of-error-msg buffer-row)
  372.  
  373. ;; if more than x errors ((length-of error-list) > x), 
  374. ;; skip over the rest of the error for this file
  375. ;; (while (or (and (booboo-line) { (snarf) file != current file })) (forward-line)
  376.  
  377.   })    ;; end while
  378.   ;; never gets here
  379. })
  380.  
  381. ;; Real life examples:
  382. ;;   HP-UX s300 8.x C:
  383. ;;     "foo.c", line 29: syntax error:
  384. ;;       static int client_socket = -1;
  385. ;;           ^
  386. ;;     "foo.c", line 180: 'client_socket' undefined
  387. ;;     "foo.c", line 198: warning: statement not reached
  388. ;;   HP-UX s800 7.x & 8.x C:
  389. ;;     cc: "xengine.c", line 70: error 1000: Unexpected symbol: "main".
  390. ;;     cc: error 2017: Cannot recover from earlier errors, terminating.
  391. ;;     *** Error code 1
  392. ;;     For some reason, the 800 seems to be sending the same error message
  393. ;;     to both stdout and stderr so I'm getting duplicates.
  394. ;;   Apollo 10.3 C:
  395. ;;     ******** Line 52 of "foo_bar.c": [Error #116]  Improper expression;
  396. ;;     ******** Line 109 of "buffer.c": [Error #060]  Improper use of "Buffer"
  397. ;;     buffer.c: 69: warning- extra characters on #endif.
  398. ;;   mc2
  399. ;;     compile.mut 381 Error: hoho is not a var.
  400.  
  401.  
  402. ;(defvar compilation-error-regexp
  403. ;  "Regular expression for filename/linenumber in error in compilation log.")
  404. ;  '\([^ \n]+\(: *\|, line \|(\)[0-9]+\)\|\([0-9]+.*of *[^ \n]+\)'
  405.  
  406. ;  \([^ \n]+\(: *        \|
  407. ;  , line             \|
  408. ;  (\)[0-9]+\)            \|
  409. ;  \([0-9]+.*of *[^ \n]+\)'
  410.  
  411. ;; Format of error messages:
  412. ;;   <file name>, line<white space><digits>
  413. ;;   <file name>:<maybe white space><digits>
  414. ;;   <file name><white space><digits><stuff>    ;; Mutt compiler
  415. ;;   <digits><stuff>of<white space><file name>
  416.  
  417.     ;; Check to see if the dot is on a line with a error message
  418.     ;; Input:
  419.     ;;   dot : at start of a line
  420.     ;; Returns:
  421.     ;;   TRUE if this is a error line
  422. (defun booboo-line HIDDEN
  423. {
  424.   (or
  425.     (looking-at '.+, line\ +[0-9]+')    ;; foo.c, line 123
  426.     (looking-at '.+: *[0-9]+.+')    ;; foo.c : 123 or foo: 123
  427.     (looking-at '[^ ]+\ +[0-9]+.+')    ;; foo.c 123
  428.     (looking-at '.* [0-9]+ +of ')    ;; 123 of foo.c
  429.   )
  430. })
  431.  
  432.     ;; Dig file name and line number out of error message
  433.     ;; Input:
  434.     ;;   Dot at start of error line.
  435.     ;; Output:
  436.     ;;   bb-fname: Name of file with error
  437.     ;;   bb-line:  Line number of error
  438.     ;; Returns: zip
  439. (defun
  440.   snarf-error-info    HIDDEN
  441.   {
  442.     (string text)
  443.  
  444.     (looking-at '.+')  
  445.     (text (get-matched "&"))
  446.  
  447.     (bb-line  (snarf-line-number text))
  448.     (bb-fname (snarf-file-name   text))
  449.   }
  450.   snarf-line-number (string error-msg) HIDDEN
  451.   {
  452.     (if
  453.       (or
  454.     (re-string '.*:\([0-9]+\):' error-msg)  ;; <stuff>:<digits>: - Grep
  455.         ;; <stuff> line <digits>:
  456.     (re-string '.* line \([0-9]+\):' error-msg)
  457.         ;; <stuff> line <digits> of
  458.     (re-string '.* line \([0-9]+\) of ' error-msg)
  459.     (re-string '.* +\([0-9]+\)' error-msg)  ;; <stuff><space><digits>
  460.     )
  461.       (convert-to NUMBER (get-matched '\1'))
  462.       { (msg "Can't find a line number in:  " error-msg) (halt) })
  463.   }
  464.   snarf-file-name (string error-msg) HIDDEN
  465.   {
  466.     (if (or
  467.         ;; <stuff>"file name", line   or (file name)
  468.       (re-string '.*["(]\([a-zA-Z0-9./_]+\)[")], line ' error-msg)
  469.         ;; "file name" or (file name)
  470.       (re-string '["(]\([a-zA-Z0-9./_]+\)[")]' error-msg)
  471.         ;; <file name><: or <space>><digits>
  472.       (re-string '\([a-zA-Z0-9./_]+\)[: ]+[0-9]' error-msg)
  473.         ;; <stuff><space><digits> of "file name" or (file name)
  474.       (re-string '.* [0-9]+ of ["(]\([a-zA-Z0-9./_]+\)[")]' error-msg)
  475.     )
  476.       (get-matched '\1')
  477.       { (msg "Can't find a file name in:  " error-msg) (halt) })
  478.   }
  479. )
  480.